home *** CD-ROM | disk | FTP | other *** search
/ Aminet 22 / Aminet 22 (1997)(GTI - Schatztruhe)[!][Dec 1997].iso / Aminet / dev / amos / amos_col.lha / AMOS-COL / 3D_CUBE.amos / 3D_CUBE.amosSourceCode
AMOS Source Code  |  1980-01-10  |  2KB  |  93 lines
  1. 'By Delta/Opium
  2. '
  3. '�ukasz ï¿½elezny
  4. 'ul. W�oska 4D/6 
  5. '42-612 Tarnowskie G�ry  
  6. 'Poland
  7. '
  8. 'Date: 05.1997 
  9. '
  10. 'REAL TIME!!!! 
  11. '
  12. Cls 0
  13. Dim XR#(8),YR#(8),ZR#(8),ZR2#(8)
  14. XM=319
  15. YM=199
  16. Read XO#,YO#,ZO#
  17. For K=1 To 8
  18.    Read XR#(K),YR#(K),ZR#(K)
  19.    If XR#(K)<0 or XR#(K)>XM or YR#(K)<0 or YR#(K)>YM Then End 
  20. Next K
  21. Screen Open 0,320,256,8,Lowres
  22. Curs Off : Flash Off : Cls 0 : Palette $0,$90,$A0,$B0,$C0,$D0,$E0,$F0
  23. Double Buffer : Autoback 0
  24. _START:
  25. X#=(X#-4)*(Pi#/180)
  26. Y#=(Y#+1)*(Pi#/180)
  27. Z#=(Z#+2)*(Pi#/180)
  28. If X#=>360 Then End 
  29. For K=1 To 8
  30.    YS#=YR#(K)
  31.    YR#(K)=YO#+(YR#(K)-YO#)*Cos(X#)+(ZR#(K)-ZO#)*Sin(X#)
  32.    ZR#(K)=ZO#+(ZR#(K)-ZO#)*Cos(X#)-(YS#-YO#)*Sin(X#)
  33. Next 
  34. For K=1 To 8
  35.    XS#=XR#(K)
  36.    XR#(K)=XO#+(XR#(K)-XO#)*Cos(Y#)-(ZR#(K)-ZO#)*Sin(Y#)
  37.    ZR#(K)=ZO#+(ZR#(K)-ZO#)*Cos(Y#)+(XS#-XO#)*Sin(Y#)
  38. Next 
  39. For K=1 To 8
  40.    XS#=XR#(K)
  41.    XR#(K)=XO#+(XR#(K)-XO#)*Cos(Z#)+(YR#(K)-YO#)*Sin(Z#)
  42.    YR#(K)=YO#+(YR#(K)-YO#)*Cos(Z#)-(XS#-XO#)*Sin(Z#)
  43. Next K
  44.  
  45. Gosub RYSUJ
  46. Goto _START
  47. RYSUJ:
  48. Locate 1,1
  49.  
  50. For G=1 To 8
  51.    ZR2#(G)=ZR#(G)
  52. Next 
  53.  
  54. Sort ZR2#(0)
  55. KOL=144
  56. Locate 1,1
  57.  
  58. Screen Swap 
  59. Cls 0
  60. If ZR#(1)=ZR#(5) Then 680
  61. If ZR#(1)>ZR#(5) Then 610
  62. Ink 2 : Polygon XR#(1),YR#(1) To XR#(2),YR#(2) To XR#(3),YR#(3) To XR#(4),YR#(4) To XR#(1),YR#(1)
  63. Goto 680
  64. 610
  65. Ink 3 : Polygon XR#(5),YR#(5) To XR#(6),YR#(6) To XR#(7),YR#(7) To XR#(8),YR#(8) To XR#(5),YR#(5)
  66. 680 If ZR#(1)=ZR#(4) Then 860
  67. If ZR#(1)>ZR#(4) Then 790
  68. Ink 4 : Polygon XR#(1),YR#(1) To XR#(2),YR#(2) To XR#(6),YR#(6) To XR#(5),YR#(5) To XR#(1),YR#(1)
  69. Goto 860
  70. '
  71. 790
  72.  
  73. Ink 5 : Polygon XR#(4),YR#(4) To XR#(3),YR#(3) To XR#(7),YR#(7) To XR#(8),YR#(8) To XR#(4),YR#(4)
  74.  
  75.  
  76. 860 If ZR#(1)=ZR#(2) Then Return 
  77. If ZR#(1)>ZR#(2) Then 970
  78.  
  79. Ink 6 : Polygon XR#(1),YR#(1) To XR#(4),YR#(4) To XR#(8),YR#(8) To XR#(5),YR#(5) To XR#(1),YR#(1)
  80.  
  81. Return 
  82.  
  83. 970
  84.  
  85. Ink 7 : Polygon XR#(2),YR#(2) To XR#(3),YR#(3) To XR#(7),YR#(7) To XR#(6),YR#(6) To XR#(2),YR#(2)
  86.  
  87. Return 
  88. '
  89. Data 140,80,124
  90. Data 164,56,100,164,104,100,116,104,100,116,56,100
  91. Data 164,56,148,164,104,148,116,104,148,116,56,148
  92.  
  93. 1150 End